Sub 快速统计专业男女生人数()
'个人使用
'集团院校通下载的学生数据快速统计男女生比例
'可以根据注释修改达到统计其他数据的目的
'28行29行代码修改为需要统计的行序列号即可
    Dim dRow As Object '定位行
    Dim dCol As Object '定位列
    Dim aData, aRes, aTemp, i As Long, x As Long, y As Long
    Dim strRow As String, strCol As String
    Dim rng As Range
Set dRow = CreateObject("scripting.dictionary")
Set dCol = CreateObject("scripting.dictionary")
aData = Range("a1").CurrentRegion '存入数组
    For i = 2 To UBound(aData) '首先遍历数组确定结果表的行数和列数
        strRow = aData(i, 32) '专业是行标签，统计专业的个数
            If Not dRow.exists(strRow) Then
                x = x + 1 '累加行数
    dRow(strRow) = x '行位置作为item
            End If
                strCol = aData(i, 3)  '性别是列标签
    If Not dCol.exists(strCol) Then
        y = y + 1
        dCol(strCol) = y '列位置作为item
    End If
Next
    ReDim aRes(1 To x, 1 To y) '调整结果数组大小
    For i = 2 To UBound(aData) '首先遍历数组确定结果表的行数和列数
        strRow = aData(i, 32) '专业名称所在列
        strCol = aData(i, 3) '性别所在列
            x = dRow(strRow) '行
            y = dCol(strCol) '列
            aRes(x, y) = aRes(x, y) + aData(i, 50) '累加
    Next
        Range("统计!b1").Resize(1, UBound(aRes, 2)) = dCol.keys '列标题
        Range("统计!a2").Resize(UBound(aRes), 1) = Application.Transpose(dRow.keys) '行标题
        Range("统计!b2").Resize(UBound(aRes), UBound(aRes, 2)) = aRes '结果数据
    Set dRow = Nothing: Set dCol = Nothing
        strMsg = "请打开统计工作簿查看结果"
        MsgBox strMsg, , "wps888.cn"
End Sub